 PAG
*********************************
*           SEG7
*********************************

]segnum = #$0700  ;current segment number

 ORG $E0C800  ;CODE RUNS HERE

* This space is shared with the VIA and the RAM.

MSGSWSET
MSGMNE ASC "mne "84
MSGAUX ASC "aux "84
MSGROM ASC "rom "84
MSGRAM ASC "ram "84
MSG1 ASC " 1  "84
MSG2 ASC " 2  "84
MSGOFF ASC "off "84
MSGON ASC "on  "84
MSGOUT ASC "out "84
MSGIN ASC "in  "84
MSG02 ASC "02  "84
MSGC02 ASC "C02 "84
MSG816 ASC "816 "84
MSGCR DFB CR,CR,CR," ",EOT

****************************************
* THIS POINT MUST BE $CA00 OR ABOVE.
****************************************

 ERR *-1/$E0CA00
 DS $E0CA00-*,$FF

 MX %11

********************************
*  I/O ROUTINES
********************************

CROUTN EQU *
CROUT LDA #$8D  ;CARRIAGE RETURN
COUT JSR SETRTS  ;SAVE STUFF IF NEEDED
 BIT IOMODE  ;CHECK I/O MODE
 BVS SEND  ;OUTPUT TO SLOT1
 BMI SEND  ;SERIAL I/O
 BIT OFFFLAG  ;DISPLAY ENABLED?
 BPL :DISP  ;IF YES
 CMP #$87  ;BELL ?
 BEQ :DISP  ;IF YES RING EVEN IF DISPLAY OFF
 CLC   ;clear "esc" flag
* Display is off so don't display
 RTS

:DISP JMP TOCOUT

SPACE LDA #$A0  ;SPACE
 BNE COUT  ;<ALWAYS>

PRERR LDA #"E"
 JSR COUT
 LDA #"R"
 JSR COUT
 JSR COUT

BELL LDA #$87  ;BELL CHAR
 BNE COUT

RDCHAR BIT IOMODE  ;SERIAL I/O?
 BMI RECEIVE  ;IF YES
 JSR SETRTS  ;INIT DISPLAY FOR EXTII OUTPUT
:OFF JSR TRANSFR7 ;READ CHARACTER
 DFB TORDCHARC ;code
 RTS

PRNTAX JSR PRBYTE
 TXA

PRBYTE PHA
 LSR
 LSR
 LSR
 LSR
 JSR PRHEX
 PLA
 AND #$0F
PRHEX ORA #$B0
 CMP #$BA
 BCC COUT
 ADC #$06
 JMP COUT

PRBLNK LDX #3

PRBL2 LDA #$A0
XSPACES JSR COUT
 DEX
 BNE XSPACES
 RTS

*-------------------------------------------------
* Slot I/O routines via Pascal 1.1 device

SEND JSR TRANSFR7 ;OUTPUT TO slot 1 or 2
 DFB OUTPASCLC ;code
 RTS

RECEIVE JSR TRANSFR7 ;INPUT FROM slot 1 or 2
 DFB INPASCALC ;code
 RTS

**************************************************
* Turn on the flag indicating the screen RAM has been changed by DDT.

SETRTS PHA  ;SAVE ACC
 PHX  ;SAVE X
 PHY  ;SAVE Y
 BIT INITFLAG ;HAS THE USER PROGRAM BEEN EXECUTED?
 BPL :ZPOK ;IF NO
 JSR TRANSFR7 ;SAVE SCREEN SWITCHES, TXT RAM IF INVIS
 DFB ZPAGSAVEC ;code
 BIT OFFFLAG ;DISPLAY OFF ?
 BMI :NOSCRN ;IF YES

 JSR SETSCRN  ;SET THE DISPLAY SWITCHES FOR EXT2 OUTPUT

:ZPOK LDA #$FF  ;SET THIS FLAG TO INDICATE THAT
 STA RESTFLAG ; SCREEN RAM AREA HAS BEEN DISTURBED

:NOSCRN PLY
 PLX
 PLA
 RTS

*-------------------------------------------------
* Must use this routine to avoid messing up the input buffer in Apple memory.
* Get line subroutine

NOTCR EQU *
 LDA IN,X
 JSR DOCOUT
 CMP #LTARROW ;IS IT LEFT ARROW
 BEQ BCKSPC
 CMP #CTRLX  ;IS IT CTRL X
 BEQ GETLNZ  ;IF YES
 CPX #25  ;RING BELL AFTER 25 CHARACTERS, AS WARNING.
 BLT NOTCR1
GETERR JSR BELL
NOTCR1 INX
 CPX #30  ;LIMIT INPUT LINE TO 30 CHARACTERS
 BNE NXTCHAR

GETLNZ JSR CROUT
GETLN LDA TFLAG  ;TRACE MODE ?
 BEQ GETNOT  ;IF NO
 LDA #"T"  ;INDICATE TRACE MODE
 JSR COUT
GETNOT LDA PROMPT
 JSR COUT
 LDX #$01
BCKSPC TXA
 BEQ GETNOT
 DEX
NXTCHAR JSR RDCHAR
GETLNNO CMP #UPARROW ;UP ARROW ?
 BEQ NXTCHAR  ;IF YES IGNORE
 CMP #ESC  ;esc key?
 BNE :CKRAROW ;if no
 RTS   ;returns with Carry set if ESC key

:CKRAROW CMP #RTARROW ;RIGHT ARROW ?
 BNE :DELTST  ;IF NO
 LDY MEMHORZ  ;SCREEN MEM POINTER

* Odd or even column
 LDA CURSHORZ ;COLUMN NUMBER
 LSR   ;SET CARRY IF ODD
 BCS :AROWMAIN ;ODD COLUMN IS MAIN MEM.
 PHP
 SEI
 STA TXTPAGE2 ;AUX ON
 LDA (BASL),Y ;GET CHAR
 STA TXTPAGE1 ;MAIN ON
 PLP
 BCC :DELTST  ;<ALWAYS>
:AROWMAIN
 LDA (BASL),Y
:DELTST CMP #DELETE
 BNE :CHKDAROW
 LDA #LTARROW ;IF YES MAKE IT LEFT ARROW
:CHKDAROW
 CMP #DNARROW ;DOWN ARROW ?
 BNE :CAPTST  ;IF NO
* It is down arrow, if tracing skip next instruction
 BIT TFLAG  ;TRACING ?
 BEQ :MAKECR  ;NOT TRACING
 LDA #">"  ;MAKE ">"
 STA IN,X  ;PUT IN BUFFER
 INX
 BNE :MAKECR  ;FOLLOW WITH <CR>

:CAPTST CMP #$E0
 BLT :ADDINP
 AND #$DF  ;SHIFT TO UPPER CASE
:ADDINP STA IN,X  ;STORE CHAR IN BUFFER
 CMP #CR  ;IS IT CARRIAGE RETURN
 BEQ :MAKECR  ;IF YES
 JMP NOTCR  ;IF NO
:MAKECR
 LDA TFLAG ; TRACE MODE ?
 BEQ :DoCRLF ; IF NO
 cpx #0 ; was "Return" the only key?
 bne :DoCRLF ; if no
 lda #$8E ; $8E is special code, CR w/no linefeed
 BIT IOMODE ; .. use regular CR if in a serial mode
 BVS :DoCRLF ; OUTPUT TO SLOT1?
 BMI :DoCRLF ; SERIAL I/O?
 jmp cout ; do special return
:DoCRLF JMP CROUT ; SEND $8D AND RETURN

* Makes reaching right edge of window look like <CR>

DOCOUT JSR COUT  ;OUTPUT
 LDY CURSHORZ
 INY
 CPY WINDWDTH ;END OF DATA AREA
 BLT :OK  ;IF NO, RETURN TO GETLN
 PLA
 PLA   ;RETURN TO CALLER OF GETLN
 INX   ;INCLUDE LAST CHAR
 JMP CROUT
:OK RTS

BELLONE CMP #$87  ;CTRL-G?
 BNE BELLRTS
 LDY #$A0
BELLTWO LDA #$0F
 JSR WAIT
 LDA SPKR
 DEY
 BNE BELLTWO
BELLRTS RTS

OUTPUT LDY CURSHORZ
 PHA   ;SAVE ACC
 TYA
 LSR   ;DIVIDE BY 2
 STA MEMHORZ  ;SCREEN MEMORY POINTER
 TAY
 PLA   ;RESTORE ACC. (CARRY NOT AFFECTED)
 BCS OUTMAIN  ;MAIN MEMORY
 JSR WRITEAUX ;WRITE ACC. TO AUX MEM.
 BCC INCCH  ;<ALWAYS>
OUTMAIN STA (BASL),Y
INCCH INC CURSHORZ
 LDA CURSHORZ
 CMP WINDWDTH
 BCS RETURN
 RTS

**************************************************
* Output a character to the screen window.
* If the right side of the window is reached, then scroll all lines in
* the window up 1 and position the cursor at bottom left.
* Windows must have an even number for the left edge.
* $8E is a special code, do a CR w/no linefeed

TOCOUT PHY
 PHA
 JSR VIDOUT
 PLA
 PLY
 CLC   ;clear "esc" flag
 RTS

VIDOUT CMP #$A0  ;CONTROL CHAR?
 BGE OUTPUT  ;IF NO
 TAY   ;POSOTIVE #?
 BPL OUTPUT  ;IF YES
 CMP #$8A  ;LINE FEED?
 BEQ LINEFEED ;IF YES
 CMP #$8D  ;CR?
 BEQ RETURN  ;IF YES
 cmp #$8E ; special CR?
 bne :chkLarw ; if no
 dec CursVert ; prevent line feed
 bra RETURN

:chkLarw CMP #$88  ;LEFT ARROW?
 BNE BELLONE  ;IF NO CHECK FOR BELL
BACKSPAC DEC CURSHORZ ;DECRMENT CURSOR HORIZ POSITION
 BPL LEFTRTS  ;POS IF NOT PAST LEFT EDGE
 INC CURSHORZ ;PUT BACK TO 0 AT LEFT EDGE OF WINDOW
LEFTRTS RTS

RETURN STZ CURSHORZ ;PUT CURSOR TO LEFT EDGE OF WINDOW

LINEFEED INC CURSVERT ;CURSOR DOWN 1 LINE
 LDA CURSVERT
 CMP WINDBTM  ;CHECK FOR WINDOW BOTTOM?
 BCC SETBASE  ;NO, SET NEW BASE ADDRESS
 DEC CURSVERT ;OFF BOTTOM, SO PUT BACK TO BOTTOM
SCROLL LDA WINDTOP  ;START AT TOP
 PHA
 JSR SETBASE  ;CALC BASE ADDRESS
 STX XBUFF  ;SAVE X
SCROLL1 LDA BASL  ;COPY BASL,X
 STA BAS2L  ;TO BAS2L,H
 LDA BASH
 STA BAS2H
 LDX WINDWDTH ;INIT X TO RIGHTMOST INDEX
 DEX   ;PUT IN 0-79 TERMS
 PLA
 ADC #$01  ;INCR LINE NUMBER
 CMP WINDBTM  ;DONE?
 BCS SCROLL3  ;YES
 PHA
 JSR SETBASE  ;CALC BASL,A
SCROLL2 TXA
 LSR   ;DIVIDE BY 2
 TAY
 BCS SCRLMAIN ;MAIN MEMORY
 LDA TXTPAGE2 ;AUX MEM ON
SCRLMAIN LDA (BASL),Y
 STA (BAS2L),Y
 BCS :SPEED  ;THIS IS FASTER
 LDA TXTPAGE1 ;MAIN MEM
:SPEED DEX   ;SHIFT LEFT ONE CHAR
 BPL SCROLL2
 BMI SCROLL1
SCROLL3 LDX XBUFF  ;RESTORE X
 LDY #$0  ;CLEAR BOTTOM LINE
 JSR CLEOLZ

VTAB LDA CURSVERT
SETBASE BIT IOMODE  ;DON'T CHANGE BASL,H IF NOT SCREEN I/O
 BMI :SKIP  ;IF SERIAL I/O
 BVS :SKIP  ;IF SLOT 1 I/O
 BIT OFFFLAG  ;DISPLAY OFF ?
 BMI :SKIP  ;IF YES

* Calc base address in BASL,H
 PHA   ;CALC BASE ADR IN BASL,H
 LSR   ;FOR GIVEN LINE NUMBER
 AND #$03  ;0<=LINE NO.<=$17
 ORA #$04
 STA BASH
 PLA
 AND #$18
 BCC :BSCLC2
 ADC #$7F
:BSCLC2 STA BASL
 ASL
 ASL
 ORA BASL
 STA BASL

 LDA WINDLEFT
 LSR   ;DIVIDE BY 2
 CLC
 ADC BASL
 STA BASL
:SKIP CLC   ;clear "esc" flag
 RTS

CLREOL LDY CURSHORZ
CLEOLZ STY MEMHORZ

* Don't clear if not screen I/O
 LDA IOMODE
 BNE :NOCLR

:CLEOL2 LDY MEMHORZ
 TYA
 LSR   ;DIVIDE BY 2, CARRY SET IF ODD COLUMN
 TAY
 LDA #$A0
 BCS :CLEAR40 ;DON'T CLEAR 1ST EVEN COL IF SETTING ON ODD
 JSR WRITEAUX ;WRITE TO SCREEN
 BCC :CLRCHK  ;<ALWAYS>
:CLEAR40 STA (BASL),Y ;WRITE SPACE
:CLRCHK INC MEMHORZ
 LDA MEMHORZ
 CMP WINDWDTH ;END OF THE LINE?
 BLT :CLEOL2  ;IF NO
:NOCLR RTS

*-------------------------------------------------
* Clear and home within window

CLRHOME LDY WINDTOP  ;START AT TOP
 STY CURSVERT
CLRBOT JSR VTAB  ;INIT BASL & BASH
 LDY #0
 JSR CLEOLZ  ;CLEAR LINE
 INC CURSVERT ;NEXT LINE
 LDA CURSVERT
 CMP WINDBTM  ;BOTTOM?
 BLT CLRBOT  ;IF NO

*-------------------------------------------------
* Home without clear

HOME STZ CURSHORZ ;LEFT EDGE
 LDY WINDTOP  ;FINISHED	
 STY CURSVERT
 JMP VTAB

***** WAIT *****

WAIT SEC
WAIT2 PHA
WAIT3 SBC #$01
 BNE WAIT3
 PLA
 SBC #$01
 BNE WAIT2
 RTS

**************************************************
* Subroutines used above

* Write the contents of the ACC to aux screen memory

WRITEAUX STA TXTPAGE2 ;AUX ON
 STA (BASL),Y ;PUT ON SCREEN
 STA TXTPAGE1 ;MAIN ON
 RTS

* Set the screen switches for output by the DDT.

SETSCRN LDA #$80
 TRB SUPERHR  ;Turn off Super Hi-Res
 LDA #0
 STA INITFLAG ;<TEMPORARY HERE> SHOW THAT APPLE SETUP SAVED
 STA TEXTON  ;TEXT MODE
 STA MIXEDOFF ;ALL TEXT
 STA COL80ON  ;80 COL DISP. ON
 STA STR80ON  ;ALLOW TXTPAGE1 TO SWITCH MAIN/AUX
 STA TXTPAGE1 ;PAGE1 OR MAIN MEM
 JMP VTAB  ;INIT BASL TO LAST ACTIVE EXT WINDOW

*-------------------------------------------------
* Display the flag window

FLGMOFF HEX 00,00,00,0A,14,1E,1E,1E

ANDDSFL HEX 02,01,04,10,20

DISFLGW LDA IOMODE  ;DON'T DISPLAY IF NOT SCREEN I/O
 BEQ :NOTSER  ;IF SCREEN I/O
 RTS

* Set window limits, start at 2nd line down

:NOTSER LDA #1
 STA WINDTOP
 LDA #42
 STA WINDLEFT
 LDA #38
 STA WINDWDTH
 LDA #5
 STA WINDBTM
 JSR HOME

* Display 1st row of flags

 LDX #5
 JSR PRBL2  ;5 SPACES
 LDA MSTATE  ;MACHINE STATE
 PHA
 LDX #0
:NEXT LDY FLGMOFF,X
 PLA
 ROL
 PHA
 JSR FLAGDISP
 INX
 CPX #8
 BNE :NEXT
 PLA
 LDY #MSGCR-MSGSWSET
 JSR BIT0

* Display 2nd row of flags

 LDA KEY  ;COMMAND PREFIX KEY
 JSR PRBYTE  ;DISPLAY AS HEX
 LDX #2
 JSR PRBL2  ;2 SPACES
 LDY #MSGOUT-MSGSWSET
 SEC
 LDA REALBRK  ;0=NO REAL BRKS
 BNE :BRK  ;IF REAL BRKS
 CLC
:BRK JSR FLAGDISP
 LDY #MSG02-MSGSWSET
 CLC
 LDA CMOSFLAG ;TYPE 02, C02, OR 816
 BEQ :TYP  ;02
 SEC
 BMI :TYP  ;C02
 CLC
 LDY #MSG816-MSGSWSET ;816
:TYP JSR FLAGDISP
 LDY #MSGOFF-MSGSWSET
 STY YBUFF
 CLC
 LDA INVISIBL ;INVIS MODE FLAG
 BPL :INV  ;IF OFF
 SEC
:INV JSR FLAGDISP
 LDX #4
:NEXTDF CLC
 LDA DISPFLAG
 AND ANDDSFL,X ;TEST PROPER BIT
 BEQ :NOTSET
 SEC
:NOTSET JSR FLAGDISP
 DEX
 BPL :NEXTDF
 RTS

FLAGDISP BCC BIT0
 INY
 INY
 INY
 INY
 INY
BIT0 CMP $C800  ;DISABLE DDT RAM
 LDA MSGSWSET,Y
 CMP $CF00  ;ENABLE DDT RAM
 JSR WRITECK7
 BCC BIT0
 RTS

**************************************************
* THIS ROUTINE MUST BE ABOVE $CF00
**************************************************

WRITECK7
 INY   ;NEXT CHARACTER
 CMP #EOT  ;FINISHED?
 BEQ WRITDON7 ;IF YES, CARRY ALSO SET
 JSR COUT  ;DISPLAY CHARACTER
 CLC
 RTS
WRITDON7
 LDY YBUFF  ;RESTORE
 SEC
 RTS

*-------------------------------------------------
* Display memory window

DISMEMW LDA IOMODE  ;DISPLAY ONLY IF SCREEN I/O
 BNE :END  ;IF NOT SCREEN I/O

* Set window limits

 LDA #6
 STA WINDTOP
 LDA #42
 STA WINDLEFT
 LDA #13
 STA WINDWDTH
 LDA #18
 STA WINDBTM
 JSR HOME

* Display selected memory locations

 LDX #11*3  ;0-11 LOCATIONS 3 BYTES EACH
:NEXTMEM LDA MEMWADR,X ;GET DATA BANK TO ACCESS
 STA DBRDDT
 LDA MEMWADR+1,X
 STA HIADD
 LDA MEMWADR+2,X
 STA LOWADD
 JSR DSMWASC  ;DISPLAY MEM W/ASCII
 CPX #0  ;AVOID SCROLL
 BEQ :END
 JSR RETURN
 DEX
 DEX
 DEX
 BPL :NEXTMEM
:END RTS

*-------------------------------------------------
* Display the effective address window

DISEFFW LDA IOMODE  ;DISPLAY ONLY IF SCREEN I/O
 BNE :END  ;IF NOT SCREEN I/O

* Set window limits
 LDA #19
 STA WINDTOP
 LDA #42
 STA WINDLEFT
 LDA #13
 STA WINDWDTH
 LDA #24
 STA WINDBTM
 JSR HOME

* Get effective address
 LDA EFFADRS+2 ;PBR OF EFFECTIVE ADRS
 STA DBRDDT  ;BANK TO ACCESS

 MEMORY16
 LDA EFFADRS

* Start display 2 bytes before effective address
 DEC
 DEC
 STA LOWADD
 MEMORY8

* Display 5 bytes
 LDX #4
:NEXTEFF LDA HIADD
 CMP #$C0  ;DO NOT DISPLAY SOFT SWITCHES
 BEQ :NEXT
 JSR DSMWASC  ;DISPLAY MEM W/ASCII
:NEXT MEMORY16
 INC LOWADD  ;INC POINTER
 MEMORY8
 CPX #0  ;AVOID SCROLL
 BEQ :END
 JSR RETURN
 DEX
 BPL :NEXTEFF
:END RTS

*-------------------------------------------------
* Display the BRK window

DISBRKW LDA IOMODE  ;DISPLAY ONLY IF SCREEN I/O
 BNE :DSEND  ;IF NOT SCREEN I/O

* Set window limits
 LDA #6
 STA WINDTOP
 LDA #56
 STA WINDLEFT
 LDA #15
 STA WINDWDTH
 LDA #17
 STA WINDBTM
 JSR CLRHOME

* Display the most recent BRK info, start with hard break.
 LDA #"H"
 JSR COUT
 JSR TRANSFR7 ;DISPLAY HARD BRK IF ANY
 DFB DSPHBPC  ;code
 JSR CROUT

* Display other BRKs
 LDY POINT  ;BRK STACK
 BEQ :DSEND  ;IF NO BRKS
 LDX #9  ;DO 10 BRKS
:NEXTBP STX XBUFF
 DEY   ;POINT AT LAST BRK
 JSR TRANSFR7 ;DISPLAY 1 BRK
 DFB DSPBRKC  ;code
 CPY #0  ;FINISHED ?
 BEQ :DSEND  ;IF YES
 LDX XBUFF
 CPX #0  ;AVOID SCROLL
 BEQ :DSEND
 JSR RETURN
 DEX
 BPL :NEXTBP
:DSEND RTS

*-------------------------------------------------
* Display protection window

DISPROTW LDA IOMODE  ;SCREEN I/O ?
 BNE :END  ;IF NOT

* Set window limits
 LDA #18
 STA WINDTOP
 LDA #56
 STA WINDLEFT
 LDA #15
 STA WINDWDTH
 LDA #24
 STA WINDBTM
 JSR HOME

* Display protection info
 LDX #6*5  ;6 BUFFERS WITH 0-5 BYTES EACH
:NEXTPRT JSR SPACE  ;1 SPACE
 LDA PROTADR,X ;GET PROTECTION INFO
 JSR COUT  ;TYPE OF PROT
 LDA PROTADR+1,X
 STA DBRDDT ;BANK TO ACCESS
 LDA PROTADR+2,X
 STA HIADD
 LDA PROTADR+3,X
 STA LOWADD
 JSR DSPADRS  ;DISPLAY 24 BIT ADDRESS
 LDA #"."
 JSR COUT
 LDA PROTADR+4,X
 STA HIADD
 LDA PROTADR+5,X
 STA LOWADD
 JSR DSP16ADR ;DISPLAY 16 BIT ADDRESS
 CPX #0  ;AVOID SCROLL
 BEQ :END
 JSR RETURN
 TXA
 SEC
 SBC #6  ;NEXT PROT BUFFER
 TAX
 BPL :NEXTPRT
:END RTS

*----------------------------------------------------
* Display FLAG, MEM, EFF, and STACK windows

DISFMES LDA IOMODE  ;SCREEN I/O ?
 BEQ :SCREEN
 JMP :END  ;IF NOT

:SCREEN BIT WINDFLG  ;are windows on?
 BPL :ON  ;If yes then skip "ON" command

 JSR TRANSFR7 ;Do "ON" command to display windows
 DFB DISPONC  ;code
 RTS

:ON JSR DISFLGW  ;DISPLAY FLAG WINDOW

 INDEX16
 TSX
 STX TEMP  ;SAVE CURRENT STACK POINTER
 LDX #DDTSTACK
 TXS   ;PUT STACK IN DDT RAM
 INDEX8

 JSR TRANSFR7 ;SWAP WORKBUFFER WITH WORK STACK
 DFB STKSWAPC ;code	

 JSR DISMEMW  ;DISPLAY MEM WINDOW
 JSR DISEFFW  ;DISPLAY EFF WINDOW

* Display STACK window

* Set window limits, start at 2nd line down
 LDA #6
 STA WINDTOP
 LDA #72
 STA WINDLEFT
 LDA #8
 STA WINDWDTH
 LDA #24
 STA WINDBTM
 JSR HOME

* Display 18 bytes of stack info
 LDX #17

* Get stack location
 STZ DBRDDT  ;ACCESS BANK 0
 LDA STACK  ;LOW BYTE OF STACK POINTER
 TAY   ;SAVE
* Start display 10 bytes above pointer
 CLC
 ADC #10
 STA LOWADD
 LDA STACK+1 ;HI BYTE OF STACK
 BIT EMULATE ;IF NATIVE MODE THEN
 BMI :ENDI ;IF NOT
 ADC #0 ;2 BYTE STACK
:ENDI STA HIADD

* Calculate pointer offset for stack buffer
 TYA
 SEC
 SBC OLDSTACK
 CLC
 ADC #STACKBUF-4
 TAY   ;Y contains stack buffer pointer

:NEXTSTK JSR DSP16ADR ;DISPLAY 16 BIT ADRS
 PHY
 LDY #0
 JSR TRANSFR7 ;GET DATA BYTE
 DFB LDAINDYC ;code
 PLY
 JSR DCOLBYT  ;DISPLAY ":" & DATA BYTE
 TXA   ;TEST COUNT TO AVOID SCROLL
 BEQ :DSEND
 JSR RETURN
 BIT EMULATE  ;IF NATIVE MODE THEN
 BMI :ENDI2  ;IF NOT
 MEMORY16  ;16 BIT ACC
:ENDI2 DEC LOWADD  ;DEC 16 BIT STACK POINTER
 MEMORY8   ;8 BIT ACC
 DEX
 BPL :NEXTSTK

:DSEND JSR TRANSFR7 ;SWAP WORK BUFFER WITH WORK STACK
 DFB STKSWAPC ;code	

 INDEX16
 LDX TEMP  ;GET STACK POINTER
 TXS   ;RESTORE
 INDEX8

:END RTS

 MX %11

***** SUBROUTINES *****

*-------------------------------------------------
* Display 24 bit address from DBRDDT, HIADD, LOWADD

DSPADRS LDA DBRDDT ;BANK
 JSR PRBYTE
 LDA #"/"
 JSR COUT

*-------------------------------------------------
* Alt entry, display 16 bit address

DSP16ADR LDA HIADD
 JSR PRBYTE
 LDA LOWADD
 JMP PRBYTE

*-------------------------------------------------
* Display 24 bit address with hex and ASCII

DSMWASC JSR DSPADRS  ;DISPLAY 24 BIT ADRS
 JSR DSPCBYT  ;DISPLAY ":" HEX BYTE

* display the ascii equivalent (don't display control codes)

 PHA
 JSR SPACE  ;1 SPACE
 PLA
 BPL :DISOK
 CMP #$A0
 BGE :DISOK
 ORA #$40  ;CHANGE TO UPPER CASE
:DISOK JMP COUT  ;DISPLAY ASCII

*-------------------------------------------------
* Display ":" followed by hex data byte

DSPCBYT LDY #0
 JSR TRANSFR7 ;GET CHAR
 DFB LDAINDYC ;code
DCOLBYT PHA  ;SAVE HEX DATA
 LDA #":"
 JSR COUT
 PLA  ;RETRIEVE CHARACTER
 PHA
 JSR PRBYTE  ;DISPLAY AS HEX
 PLA
 RTS

***** THIS SEGMENTS GLOBAL SUBROUTINES *****

SUBTABL7

COUTC EQU *-SUBTABL7*4+7+$100
 DA COUT-1

CROUTC EQU *-SUBTABL7*4+7+$100
 DA CROUT-1

RDCHARC EQU *-SUBTABL7*4+7+$100
 DA RDCHAR-1

PRERRC EQU *-SUBTABL7*4+7+$100
 DA PRERR-1

PRBL2C EQU *-SUBTABL7*4+7+$100
 DA PRBL2-1

PRBLNKC EQU *-SUBTABL7*4+7+$100
 DA PRBLNK-1

PRBYTEC EQU *-SUBTABL7*4+7+$100
 DA PRBYTE-1

PRNTAXC EQU *-SUBTABL7*4+7+$100
 DA PRNTAX-1

PRHEXC EQU *-SUBTABL7*4+7+$100
 DA PRHEX-1

RECEIVEC EQU *-SUBTABL7*4+7+$100
 DA RECEIVE-1

GETLNC EQU *-SUBTABL7*4+7+$100
 DA GETLN-1

GETLNZC EQU *-SUBTABL7*4+7+$100
 DA GETLNZ-1

GETLNNOC EQU *-SUBTABL7*4+7+$100
 DA GETLNNO-1

CLREOLC EQU *-SUBTABL7*4+7+$100
 DA CLREOL-1

BELLC EQU *-SUBTABL7*4+7+$100
 DA BELL-1

WAITC EQU *-SUBTABL7*4+7+$100
 DA WAIT-1

SETSCRNC EQU *-SUBTABL7*4+7+$100
 DA SETSCRN-1

VTABC EQU *-SUBTABL7*4+7+$100
 DA VTAB-1

CLRHOMEC EQU *-SUBTABL7*4+7+$100
 DA CLRHOME-1

HOMEC EQU *-SUBTABL7*4+7+$100
 DA HOME-1

DISFLGWC EQU *-SUBTABL7*4+7+$100
 DA DISFLGW-1

DISMEMWC EQU *-SUBTABL7*4+7+$100
 DA DISMEMW-1

DISBRKWC EQU *-SUBTABL7*4+7+$100
 DA DISBRKW-1

DISPROTWC EQU *-SUBTABL7*4+7+$100
 DA DISPROTW-1

DISFMESC EQU *-SUBTABL7*4+7+$100
 DA DISFMES-1

*****************************************
*  SEGMENT CROSSOVER AREA  *
*****************************************

 LST ON
S7END = $E0CF91-*
 do nolist
 LST OFF
 fin
 ERR *-1/$E0CF91
 DS $E0CF91-*,$FF


******** SAVE THE ACC, X, Y AND P REGISTERS *******
* Returns with MX = 11, savesEregisters

SAVEAXP7
 PHP   ;SAVE STATUS
 MX16
 STX XSAVESEG ;save 16 bits
 STY YSAVESEG ;save 16 bits
 STA ASAVESEG ;save 16 bits
 MX8
 PLA   ;GET STATUS
 STA PSAVESEG ;SAVE
 RTS

****** RESTORE THE ACC, X, Y AND P REGISTERS ******
* restores registers

RESTAXP7
 MEMORY8
 LDA PSAVESEG
 PHA
 MX16
 LDX XSAVESEG
 LDY YSAVESEG
 LDA ASAVESEG
 PLP
 RTS
 MX %11

*----------------------------------------
* Do a direct transfer to other segments

JUMPSEG7
 JSR SAVEAXP7
 LDY SLOTN0
 PLA   ;pull junk byte from dest. seg
 PLA   ;get destination segment
 STA SEGMBASE,Y ;the next inst' will be in new seg
 JSR RESTAXP7 ;restore after xfer from other seg
 RTS   ;pull destination address from stack

* TRANSFER TO OTHER SEGMENTS

TRANSFR7

 JSR SAVEAXP7
 MEMORY16
 PLA   ;get return address from stack
 INC   ;inc to point at code byte & for RTS
 PHA
 MEMORY8
 LDA #7  ;CURRENT SEG #
 PHA
 LDY #0
 LDA (2,S),Y  ;GET CODE BYTE
 PHA   ;SAVE CODE
 AND #$07  ;STRIP ALL BUT SEG #
 LDY SLOTN0
 STA SEGMBASE,Y ;NEXT INSTR. RUN FROM NEW SEGMENT
* NEW SEGMENT
 PLA   ;GET CODE
 PEA RETURN7  ;where to return to
 AND #$F8  ;STIP OFF SEG# LEAVING SUB #
 LSR
 LSR   ;LEAVE SUB# MULTIPLIED BY 2
* GET ADDRESS OF SUB FROM SUBTABL & PUSH ON STACK
 TAY
 MEMORY16
 LDA SUBTABL7,Y
 PHA
 BRA RESTAXP7 ;RESTORE REGISTERS, RTS TO SUBROUTINE
 MX %11

* RETURN HERE FROM SUBROUTINE

RETURN7 EQU *-1
 JSR SAVEAXP7
 PLA   ;SEG # TO RETURN TO
 LDY SLOTN0
 STA SEGMBASE,Y ;RETURN TO SEGMENT
 BRA RESTAXP7

 DS \,$FF  ;PUT OBJECT AT NEXT PAG
